home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / fielddh.exe / COLOR_AP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-04-30  |  11.3 KB  |  317 lines
  1. {*--------------------------------------------------------------------------*}
  2. {*   To Use the COLOR features (Buttons, etc) you must:                     *}
  3. {*     0: Have your application be a PCOLOR_APP from this unit!!!!          *}
  4. {*     1: Have your DIALOG be a PCOLOR_DIALOG from this unit!               *}
  5. {*     2: Pascal-Code the PCOLOR_BUTTONS/PCOLOR_STATICTEXT exactly          *}
  6. {*        the same as if they were 'normal' TButton/TStaticText.            *}
  7. {*     3: The FIELDS unit knows about these COLOR objects.                  *}
  8. {*--------------------------------------------------------------------------*}
  9. UNIT Color_App;    {Colored Application Buttons/TEXT!!}
  10.  
  11.  
  12. INTERFACE
  13. USES App,       {TVISION, modified version to handle COLOR buttons!}
  14.      Dialogs,   {TVISION, button}
  15.      Views,     {TVision, titlestr}
  16.      Objects;   {TVision, misc}
  17.  
  18. CONST
  19.   Button_Color_Default :byte = 0;     {green}
  20.   Button_Black         :byte = 1;
  21.   Button_Dk_Blue       :byte = 2;
  22.   Button_Green         :byte = 3;
  23.   Button_Cyan          :byte = 4;
  24.   Button_Red           :byte = 5;
  25.   Button_Purple        :byte = 6;
  26.   Button_Brown         :byte = 7;
  27.   Button_Grey          :byte = 8;
  28.  
  29.   Button_Dk_Grey       :byte = 9;
  30.   Button_Lt_Blue       :byte = 10;
  31.   Button_Lt_Green      :byte = 11;
  32.   Button_Lt_Cyan       :byte = 12;
  33.   Button_Lt_Red        :byte = 13;
  34.   Button_Lt_Purple     :byte = 14;
  35.   Button_Yellow        :byte = 15;
  36.   Button_White         :byte = 16;
  37.  
  38. TYPE
  39.   PColor_InputLine = ^Color_Inputline;
  40.   Color_InputLine = OBJECT(TInputLine)
  41.     constructor Init (var Bounds: TRect; AMaxLen: Integer;
  42.                       Button_Color_ID : byte);   {new parameter!}
  43.     function GetPalette : PPalette; virtual;     {MUST Override!}
  44.   private
  45.     Color         : word;
  46.   end; {color_inputline}
  47.  
  48.  
  49.   PColor_Button = ^Color_Button;
  50.   Color_Button = object(DIALOGS.TButton)
  51.     constructor Init (var Bounds      : OBJECTS.TRect;
  52.                       ATitle          : VIEWS.TTitleStr;
  53.                       ACommand        : Word;
  54.                       AFlags          : Byte;
  55.                       Button_Color_ID : byte);   {new parameter!}
  56.     function GetPalette : PPalette; virtual;     {MUST Override!}
  57.     procedure New_Color (Button_Color_ID : Byte);
  58.     function Get_Color : integer;
  59.     procedure Hide_Shadow;
  60.   private
  61.     Color         : word;
  62.     Shadow_Hidden : boolean;
  63.   end; {Color_Button}
  64.  
  65.   PColor_StaticText = ^Color_StaticText;
  66.   Color_StaticText = object(DIALOGS.TStaticText)
  67.     constructor Init (var Bounds      : OBJECTS.TRect;
  68.                       AText           : string;
  69.                       Button_Color_ID : byte);   {new parameter!}
  70.     function GetPalette : PPalette; virtual;     {MUST Override!}
  71.   private
  72.     Color         : word;
  73.   end; {Color_StaticText}
  74.  
  75.   PColor_Dialog = ^Color_Dialog;
  76.   Color_Dialog = object(TDialog)
  77.     constructor init (var bounds: TRect; ATitle: TTitleStr);
  78.     function GetPalette : PPalette; virtual;     {MUST Override!}
  79.   end; {Color_Dialog}
  80.  
  81.  
  82.   PColor_Application = ^Color_Application;
  83.                  {this elimates need to tweak APP.pas}
  84.   Color_Application = object(TApplication)
  85.     function GetPalette : PPalette; virtual;     {MUST Override!}
  86.   end; {Color_Application}
  87.  
  88.   {*-----------------------------------------------------------*}
  89.   {* If you want blinking, you must call SetBlink(TRUE)        *}
  90.   {* after a color dialog                                      *}
  91.   {*-----------------------------------------------------------*}
  92.   procedure SetBlink(State: Boolean);
  93.  
  94.  
  95. {*************************************************************************}
  96. {*************************************************************************}
  97. {*************************************************************************}
  98. IMPLEMENTATION
  99.  
  100.  
  101. {*************************************************************************}
  102. procedure SetBlink(State: Boolean); assembler; {by steve shafer}
  103. asm
  104.   mov ax,$1003
  105.   mov bl,state
  106.   push bp
  107.   int $10
  108.   pop bp
  109. end; {setblink}
  110.  
  111.  
  112. {**************************************************************************}
  113. constructor Color_InputLine.Init;
  114. begin
  115.   TInputLine.Init (Bounds, AMaxLen);
  116.   Color := Button_Color_ID;
  117. end; {init}
  118.  
  119. {**************************************************************************}
  120. function Color_InputLine.GetPalette : PPalette;
  121. const
  122.   D_Palette : string[4] = '';
  123. begin
  124.   {*-----------------------------------------------------------------------*}
  125.   {* Must be VAR rather than const to RESET to default each time!          *}
  126.   {*   (changes to a const version of D_Palette is REMEMBERED!)            *}
  127.   {*-----------------------------------------------------------------------*}
  128.         {#19#19#20#21;  => TVision default colors for TInputLine}
  129.   D_Palette := TInputLine.GetPalette^;
  130.  
  131.   IF ((Color > 0) and (Color < 17)) THEN
  132.     BEGIN
  133.       D_Palette[1] := CHAR(30+(Color*3));     {normal}
  134.       D_Palette[2] := D_Palette[1];
  135.       D_Palette[3] := CHAR(30+(Color*3)+1);   {selected}
  136.     END;
  137.  
  138.   GetPalette := @D_Palette;
  139. end; {getpalette}
  140.  
  141. {**************************************************************************}
  142. constructor Color_Button.Init;
  143. begin
  144.   TButton.Init (Bounds, ATitle, ACommand, AFlags);
  145.   Color := Button_Color_ID;
  146.   Shadow_Hidden := FALSE;
  147. end; {init}
  148.  
  149. {**************************************************************************}
  150. procedure Color_Button.New_Color;
  151. begin
  152.   Color := Button_Color_ID;
  153.   Draw;  {display the change}
  154. end; {new_color}
  155.  
  156. {**************************************************************************}
  157. function Color_Button.Get_Color : integer;
  158. begin
  159.   Get_Color := Color;
  160. end; {get_color}
  161.  
  162. {**************************************************************************}
  163. procedure Color_Button.Hide_Shadow;
  164. begin
  165.   Shadow_Hidden := TRUE;
  166.   Draw;  {display the change}
  167. end; {hide_shadow}
  168.  
  169. {**************************************************************************}
  170. function Color_Button.GetPalette : PPalette;
  171.    {*  NOTE: Colors assumes use of COLOR Monitor!!!!  *}
  172.  {  bckgrnd / letters
  173.    49=NO SHADOW       (maybe want to instead use char[1]?)
  174.   0 - black         4 - red           8 - dark gray     C - light red
  175.   1 - blue          5 - magenta       9 - light blue    D - light magenta
  176.   2 - green         6 - brown         A - light green   E - yellow
  177.   3 - cyan          7 - light gray    B - light cyan    F - white
  178.  }                                       {see pg 107 on methodology}
  179. const
  180.   D_Palette : string[8] = '';
  181. begin
  182.   {*-----------------------------------------------------------------------*}
  183.   {* Must be VAR rather than const to RESET to default each time!          *}
  184.   {*   (changes to a const version of D_Palette is REMEMBERED!)            *}
  185.   {*-----------------------------------------------------------------------*}
  186.      {#10#11#12#13#14#14#14#15;  => TVISION default colors for TButton}
  187.   D_Palette := TButton.GetPalette^;
  188.  
  189.   IF ((Color > 0) and (Color < 17)) THEN
  190.     BEGIN
  191.       D_Palette[1] := CHAR(30+(Color*3));     {normal}
  192.       D_Palette[2] := D_Palette[1];           {normal for highlights}
  193.       D_Palette[3] := CHAR(30+(Color*3)+1);   {selected button}
  194.  
  195.       D_Palette[5] := CHAR(30+(Color*3)+2);   {shortcut}
  196.       D_Palette[6] := D_Palette[5];
  197.       D_Palette[7] := D_Palette[6];
  198.     END;
  199.   IF (Shadow_Hidden)
  200.     THEN D_Palette[8] := #81;  {set to EXTENDED set (background)}
  201.  
  202.   GetPalette := @D_Palette;
  203. end; {getpalette}
  204.  
  205. {**************************************************************************}
  206. constructor Color_StaticText.Init;
  207. begin
  208.   TStaticText.Init (Bounds, AText);
  209.   Color := Button_Color_ID;
  210. end; {init}
  211.  
  212. {**************************************************************************}
  213. function Color_StaticText.GetPalette : PPalette;
  214. const
  215.   D_Palette : string[1] = '';
  216. begin
  217.   {*-----------------------------------------------------------------------*}
  218.   {* Must be VAR rather than const to RESET to default each time!          *}
  219.   {*   (changes to a const version of D_Palette is REMEMBERED!)            *}
  220.   {*-----------------------------------------------------------------------*}
  221.        {#6;  => TVISION default colors for TButton}
  222.   D_Palette := TStaticText.GetPalette^; {TVision default colors for TStaticText}
  223.  
  224.   IF ((Color > 0) and (Color < 17))
  225.     THEN D_Palette[1] := CHAR(30+(Color*3));     {normal}
  226.  
  227.   GetPalette := @D_Palette;
  228. end; {getpalette}
  229.  
  230.  
  231. {**************************************************************************}
  232. constructor Color_Dialog.Init (var bounds: TRect; ATitle: TTitleStr);
  233. begin
  234.   TDialog.Init (bounds, ATitle);
  235.   SetBlink(False);
  236. end; {init}
  237.  
  238. {**************************************************************************}
  239. function Color_Dialog.GetPalette : PPalette;
  240. const
  241.   (*#32#33#34#35#36#37#38#39#40#41#42#43#44#45#46#47#48#49#50#51#52#53#54+
  242.     #55#56#57#58#59#60#61#62#63+  {end of default CDialog}
  243.     {*--------------------------------------------------------*}
  244.     {* positions 33..110 is mapped similar pg 230 CDialog into *}
  245.     {* a MODIFIED APP.CColor!                                 *}
  246.     {*--------------------------------------------------------*}
  247.   *)
  248.   New_Palette : string[49] = {32}
  249.       #64#65#66+
  250.       #67#68#69+
  251.       #70#71#72+
  252.       #73#74#75+
  253.       #76#77#78+
  254.       #79#80#81+
  255.       #82#83#84+
  256.       #85#86#87+
  257.  
  258.       #88#89#90+     {dk gray}
  259.       #91#92#93+     {lt blue}
  260.       #94#95#96+     {lt green}
  261.       #97#98#99+     {lt cyan}
  262.       #100#101#102+  {lt red}
  263.       #103#104#105+  {lt magenta}
  264.       #106#107#108+  {yellow}
  265.       #109#110#111+  {white}
  266.       #112;          {hide-shadow}
  267.   D_Palette  : string [32+49] = ''; {32+new}
  268. begin
  269.   D_Palette := TDialog.GetPalette^ + {TVision default colors for TDialog}
  270.                   New_Palette;
  271.   GetPalette := @D_Palette;
  272. end; {getpalette}
  273.  
  274. {**************************************************************************}
  275. function Color_Application.GetPalette : PPalette;
  276. const
  277.   (*  #32#33#34#35#36#37#38#39#40#41#42#43#44#45#46#47#48#49#50#51#52#53#54+
  278.     #55#56#57#58#59#60#61#62#63+  {end of default CDialog}
  279.     {*--------------------------------------------------------*}
  280.     {* positions 32..63 is mapped similar pg 230 CDialog into *}
  281.     {* a MODIFIED APP.CColor!                                 *}
  282.     {*--------------------------------------------------------*}
  283.   *)
  284.     {*----------------------------------------*}
  285.     {* DWH Specific access for COLORS/TEXT!   *}
  286.     {*  (since dont have MULTI-inheritance)   *}
  287.     {*----------------------------------------*}
  288.   New_Palette : string[49] = {31}
  289.     #$07#$0F#$0E+
  290.     #$17#$1F#$1E+
  291.     #$20#$2F#$2E+
  292.     #$30#$3F#$3E+
  293.     #$40#$4F#$4E+
  294.     #$50#$5F#$5E+
  295.     #$60#$6F#$6E+
  296.     #$70#$7F#$7E+
  297.  
  298.     #$80#$8F#$8E+    {dk gray}
  299.     #$90#$9F#$9E+    {lt blue}
  300.     #$A0#$AF#$AE+    {lt green}
  301.     #$B0#$BF#$BE+    {lt cyan}
  302.     #$C0#$CF#$CE+    {lt red}
  303.     #$D0#$DF#$DE+    {lt magenta}
  304.     #$E0#$E7#$E2+    {yellow}
  305.     #$F0#$F7#$F2+    {white}
  306.     #$77;            {hide the shadow}
  307. CONST
  308.   D_Palette  : string [63+49] = '';
  309. begin
  310.   D_Palette := TApplication.GetPalette^ +  {TVision default colors for TDialog}
  311.                          + New_Palette;
  312.   GetPalette := @D_Palette;
  313. end; {getpalette}
  314.  
  315.  
  316. END. {color_App}
  317.